home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
improv1a
/
progress.ctl
< prev
next >
Wrap
Text File
|
1999-08-27
|
9KB
|
298 lines
VERSION 5.00
Begin VB.UserControl Progress
Alignable = -1 'True
BackStyle = 0 'Transparent
ClientHeight = 525
ClientLeft = 0
ClientTop = 0
ClientWidth = 4905
EditAtDesignTime= -1 'True
ForeColor = &H8000000F&
ForwardFocus = -1 'True
PropertyPages = "Progress.ctx":0000
ScaleHeight = 525
ScaleWidth = 4905
ToolboxBitmap = "Progress.ctx":0023
Begin VB.PictureBox Pic1
AutoRedraw = -1 'True
FillStyle = 0 'Solid
FontTransparent = 0 'False
Height = 375
Left = 60
ScaleHeight = 315
ScaleWidth = 4695
TabIndex = 0
Top = 60
Width = 4755
End
End
Attribute VB_Name = "Progress"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'
' Progress Bar Control - By Jack Rizzo, SBN Software
'
' Based on a routine developed by Aldo Peirano and submitted
' to "Visual Basic Source Code" on 15 August, 1999.
'
Option Explicit
Enum StyleA
[PercentHorz]
[LabelPercentHorz]
[BareLabelHorz]
[BareLabelVert]
[PercentVert]
End Enum
Enum BsytleA
[Flat]
[3D]
End Enum
Private m_Caption As String
Private m_Visible As Boolean
Private m_Enabled As Boolean
Private m_ForeColor As Long
Private m_Max As Long
Private m_Min As Long
Private m_Style As StyleA
Private m_Border As BsytleA
'MappingInfo=UserControl,UserControl,-1,ForeColor
Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "Sets Color of the Progess Bar and Associated text"
Attribute ForeColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
ForeColor = UserControl.ForeColor
End Property
Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
UserControl.ForeColor() = New_ForeColor
Pic1.ForeColor = New_ForeColor
PropertyChanged "ForeColor"
End Property
'MappingInfo=UserControl,UserControl,-1,Font
Public Property Get Font() As Font
Attribute Font.VB_Description = "Sets the font for the progress bar text"
Attribute Font.VB_ProcData.VB_Invoke_Property = ";Font"
Set Font = UserControl.Font
End Property
Public Property Set Font(ByVal New_Font As Font)
Set UserControl.Font = New_Font
PropertyChanged "Font"
End Property
'MappingInfo=UserControl,UserControl,-1,Visible
Public Property Get Visible() As Boolean
Attribute Visible.VB_Description = "Boolean value making progress bar visible or not."
Attribute Visible.VB_ProcData.VB_Invoke_Property = ";Behavior"
Visible = m_Visible
End Property
Public Property Let Visible(ByVal New_Visible As Boolean)
m_Visible = New_Visible
Pic1.Visible = m_Visible
PropertyChanged "Visible"
End Property
'mappingInfo=UserControl,UserControl,-1,Caption
Public Property Get Caption() As String
Attribute Caption.VB_Description = "Defines the Lable to be used in the bar for styles that use lables."
Caption = m_Caption
End Property
Public Property Let Caption(ByVal New_Caption As String)
m_Caption = New_Caption
PropertyChanged "Caption"
End Property
Public Function Change(Value As Long)
Attribute Change.VB_Description = "Method used to change the progress bar value."
Dim myval As Long
If m_Enabled = False Then
Exit Function
End If
myval = Value
If myval < Min Or myval > Max Then
Err.Raise vbObjectError + 1, "Progress", "Progress Bar Value for Min or Max out of bounds"
End If
If Min = Max Then
Err.Raise vbObjectError + 2, "Progress", "Progress Bar Min and Max are Equal"
End If
If Max < Min Then
Err.Raise vbObjectError + 3, "Progress", "Progress Bar Max value is less than Min"
End If
Select Case Style
Case PercentHorz
Call Prog(Pic1, myval, Max)
Case LabelPercentHorz
If Left(Caption, 1) <> "%" Then
Caption = "%" & Caption
End If
Call Prog(Pic1, myval, Max, Caption)
Case BareLabelHorz
Call Prog(Pic1, myval, Max)
Case BareLabelVert
Call Prog(Pic1, myval, Max)
Case PercentVert
Call Prog(Pic1, myval, Max)
End Select
Pic1.Refresh
DoEvents
End Function
Public Function Clear()
Attribute Clear.VB_Description = "Clears the progress bar."
If m_Enabled = False Then
Exit Function
End If
Pic1.Cls
End Function
Private Sub Prog(OBJ As PictureBox, ByVal Current As Long, _
Max As Long, Optional Caption As String)
Dim myscale As Long
Dim Percent As String
Dim Tmp As Long
Dim xcount As Single
Dim base As Single
Dim xxy As Single
If Current < Min Or Current > Max Then
Exit Sub
End If
If Not OBJ.AutoRedraw Then
OBJ.AutoRedraw = -1
End If
OBJ.Cls
If Caption = "" Then
Percent = Format(Str((Current - Min) / (Max - Min + 1)) * 100, "###0") + "%"
ElseIf Left(Caption, 1) = "%" Then
Percent = Mid(Caption, 2, Len(Caption) - 1) + " " + Format(Str((Current - Min) / (Max - Min + 1)) * 100, "###0") + "%"
Else
Percent = Caption
End If
OBJ.ScaleWidth = Max - Min
OBJ.DrawMode = 10
OBJ.Font = UserControl.Font
OBJ.Font.Size = UserControl.Font.Size
OBJ.ForeColor = UserControl.ForeColor
OBJ.Font.Bold = UserControl.Font.Bold
OBJ.Font.Italic = UserControl.Font.Italic
OBJ.Font.Underline = UserControl.Font.Underline
If Style <> BareLabelHorz And Style <> BareLabelVert Then
OBJ.CurrentX = (OBJ.ScaleWidth / 2 - OBJ.TextWidth(Percent) / 2)
OBJ.CurrentY = (OBJ.ScaleHeight - OBJ.TextHeight(Current)) / 2
OBJ.Print Percent
End If
If Style > 2 Then
OBJ.ScaleHeight = Max - Min
myscale = OBJ.ScaleHeight - (Current - Min)
OBJ.Line (0, OBJ.ScaleHeight)-(OBJ.ScaleWidth, myscale), , BF
Else
OBJ.Line (0, 0)-((Current - Min), OBJ.Width), , BF
End If
OBJ.Refresh
DoEvents
End Sub
Private Sub UserControl_Initialize()
m_Enabled = True
m_Visible = True
m_ForeColor = ForeColor
m_Border = [3D]
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
UserControl.ForeColor = PropBag.ReadProperty("ForeColor", m_ForeColor)
Set Font = PropBag.ReadProperty("Font", Ambient.Font)
m_Visible = PropBag.ReadProperty("Visible", True)
m_Style = PropBag.ReadProperty("Style", m_Style)
m_Border = PropBag.ReadProperty("Border", m_Border)
m_Enabled = PropBag.ReadProperty("Enabled", m_Enabled)
m_Caption = PropBag.ReadProperty("Caption", m_Caption)
m_Max = PropBag.ReadProperty("Max", m_Max)
m_Min = PropBag.ReadProperty("Min", m_Min)
End Sub
Private Sub UserControl_Resize()
Pic1.Width = UserControl.Width - 165
Pic1.Height = UserControl.Height - 100
Pic1.BorderStyle = m_Border
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("ForeColor", UserControl.ForeColor, m_ForeColor)
Call PropBag.WriteProperty("Font", Font, Ambient.Font)
Call PropBag.WriteProperty("Visible", m_Visible, True)
Call PropBag.WriteProperty("Style", m_Style, 0)
Call PropBag.WriteProperty("Border", m_Border, 1)
Call PropBag.WriteProperty("Enabled", m_Enabled, True)
Call PropBag.WriteProperty("Caption", m_Caption, "")
Call PropBag.WriteProperty("Min", m_Min, 0)
Call PropBag.WriteProperty("Max", m_Max, 100)
End Sub
'MappingInfo,UserControl,UserControl,-1,Style
Public Property Get Style() As StyleA
Attribute Style.VB_Description = "One of five styles for displaying the Progress bar."
Attribute Style.VB_ProcData.VB_Invoke_Property = ";Appearance"
Style = m_Style
End Property
Public Property Let Style(ByVal vNewValue As StyleA)
m_Style = vNewValue
PropertyChanged "Style"
End Property
Public Property Get border() As BsytleA
Attribute border.VB_Description = "Defines one of two types of borders for display. Either Flat or 3D."
border = m_Border
End Property
Public Property Let border(ByVal NewValue As BsytleA)
m_Border = NewValue
If m_Border = [3D] Then
Pic1.BorderStyle = 1
Else
Pic1.BorderStyle = 0
End If
PropertyChanged "Border"
End Property
'MappingInfo,UserControl,UserControl,-1,Enable
Public Property Get Enabl